home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / pubdom.tar / pubdom / rbj / myr < prev    next >
Text File  |  1990-05-09  |  4KB  |  59 lines
  1. %%HP: T(3)A(D)F(.);
  2. @  MYR          Display a calendar for a month/year:   month year MYR
  3. @   RBJ 4/16/90 Initial Code
  4. @       4/19/90 Replaced list of "dd" string with computed CROW function
  5. @       4/23/90 Moved code inline, local function g (old CROW), p
  6. @               removed utility function "library, use SUB string in 
  7. @               local function g for SPEED.  One character local variables
  8. @       4/24/90 Improved annotation 
  9. @       4/25/90 Revised day of week, eliminate extra ->STR 
  10. @       5/08/90 Use Flag 9 vs 1 for printer control , elim F2
  11. @
  12. @   User Flags: F9: If set sends text lines to printer
  13. \<<                                         @ month year -> display
  14.   \<<                                       @ Local Function 'g' b e -> "b..e"
  15.                                             @ Returns row of calendar.  This
  16.     " 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 "      @ should be 1 string,
  17.     "16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31" +  @ but avoid wrap on PC
  18.     ROT 3 * 2 - ROT 3 * 1 - SUB             @ Extract desired part of string
  19.   \>>
  20.   \<<                                       @ Local function 'p' PRT/DISP
  21.     IF DUP TYPE 7 ==                        @ If local name (the row number)
  22.     THEN INCR OVER SWAP DISP END            @ Increment row & display
  23.     IF 9 FS? THEN PR1  END                  @ Print if requested by Flag 9
  24.     DROP                                    @ Drop String (Was retained by F2)
  25.   \>>                                       @ CREATE LOCALS:
  26.   RCLF 0 0 0 1 0 0 \-> m y g p              @ month, year, func g, func p,
  27.      f d n i b e r                          @ flags, date, ndays, indent,
  28.                                             @   begin, end, screen row
  29.   \<<                                       @ THE REAL PROGRAM
  30.     y 1E6 / m + .01 + DUP 'd' STO           @ Date first of month
  31.     10.171582 SWAP DDAYS 7 MOD              @ Day of Week (0..6 for SMTWTFS) 
  32.     'i' STO                                 @ Number of days to indent
  33.     IF m 12 ==                              @ Figure number of days in month
  34.     THEN 31 ELSE d DUP 1 + DDAYS            @ where December is special case
  35.     END 'n' STO                             @ Store as n
  36.     CLLCD "       "                         @ Centering string
  37.     "JanFebMarAprMayJunJulAugSepOctNovDec"  @ Month Names
  38.     m 3 * DUP 2 - SWAP SUB                  @ Extract correct portion
  39.     + " " + STD y +                         @ Now have the Month Year string
  40.     'r' p EVAL                              @ 'Row' Prt/Disp
  41.     " S  M  T  W  T  F  S" 
  42.     IF n i + 35 \<=                         @ Only Display if it fits
  43.     THEN 'r' END p EVAL
  44.     7 i - 'e' STO                           @ Dates first row (b set above)
  45.     i 3 *                                   @ Generate indent string
  46.     "         " DUP + 1 ROT SUB             @ Nblank function inline
  47.     b e g EVAL +                            @ First row
  48.     'r' p EVAL                              @ 'Row'Prt/Disp
  49.     DO
  50.       e 1 + 'b' STO                         @ Start of next row
  51.       e 7 + n MIN 'e' STO                   @ End of next row
  52.       b e g EVAL                            @ Generate next row
  53.       'r' p EVAL                            @ 'Row' Prt/Disp
  54.     UNTIL e n == END                        @ Until listed last day of month
  55.     3 FREEZE                                @ Hold screen
  56.     f STOF                                  @ Restore Flags
  57.   \>>
  58. \>>
  59.